#!/usr/bin/env perl
use warnings;
use strict;

# Tests are organized into groups; each group contains a list of names of
# tests to run in that group.
my %tests;
my $group;
sub test {
  my $group_tests = $tests{$group};
  $group_tests = "" unless $group_tests;
  $group_tests .= " ".join(" ", @_);
  $tests{$group} = $group_tests;
}

# Add file(s) to the list of files to delete when running make clean.
sub clean {
  print "CLEAN_FILES += ".join(" ",@_)."\n";
}

# Create a file with the given name and rows.
sub file {
  my ($name, @rows) = @_;
  clean($name);
  print "$name: $0\n";
  print "\tmkdir -p test\n";
  print "\techo \"".$rows[0]."\" >$name\n";
  for (my $i = 1; $i < scalar(@rows); ++$i) {
    print "\techo \"".$rows[$i]."\" >>$name\n";
  }
}

# Write rule that runs given perl script.
sub perl {
  my ($out, $in, $script, @args) = @_;
  my $arg_string = join(" ",@args);
  clean($out);
print <<STR;
$out: $0 $in $script
\tperl $script $arg_string >$out
STR
}

# Write rule that runs given program.
sub prog {
  my ($out, $in, $prog, @args) = @_;
  my $arg_string = join(" ",@args);
  clean($out);
  print <<STR;
$out: $0 $in bin/$prog
\tbin/$prog $arg_string >$out
STR
}

# Run command that should produce given output lines.
sub test_diff {
  my ($name, $in, $cmd, @exp_lines) = @_;
  my $obs = "test/$name.observed";
  my $exp = "test/$name.expected";
  test($name);
  file($exp, @exp_lines);
  print <<STR;
$name: $0 $in $exp
\t$cmd >$obs
\tdiff $obs $exp
\trm -f $obs $exp
STR
}

# Test two programs that are inverse of one another.
sub test_inverses_prog {
  my ($name, $in, $fwd, $bwd, @args) = @_;
  my $arg_string = join(" ",@args);
  my $inv = "$in.from_inverse";
  test($name);
  clean($inv);
  print<<STR;
$name: $in bin/$fwd bin/$bwd
\tbin/$fwd $arg_string <$in | bin/$bwd $arg_string >$inv
\tdiff $in $inv
STR
}

# Test two perl scripts that are inverse of one another.
sub test_inverses_perl {
  my ($name, $in, $fwd, $bwd, @args) = @_;
  my $arg_string = join(" ",@args);
  my $inv = "$in.from_inverse";
  test($name);
  clean($inv);
  print<<STR;
$name: $in $fwd $bwd
\tperl $fwd $arg_string <$in | perl $arg_string $bwd >$inv
\tdiff $in $inv
STR
}

# Test two bash scripts that are inverse of one another.
sub test_inverses_bash {
  my ($name, $in, $fwd, $bwd, @args) = @_;
  my $arg_string = join(" ",@args);
  my $inv = "$in.from_inverse";
  test($name);
  clean($inv);
  print<<STR;
$name: $in $fwd $bwd
\tbash $fwd $arg_string <$in | bash $arg_string $bwd >$inv
\tdiff $in $inv
STR
}

###############################################################################
$group = "test_block_tuple";
###############################################################################
file("test/probe.txt",
  "1:",
  "30878",
  "2647871",
  "1283744",
  "2488120",
  "317050",
  "1904905",
  "1989766",
  "10:",
  "1952305",
  "1531863",
  "1000:",
  "2326571",
  "977808");

test_inverses_perl($group."_inverse_1",
  "test/probe.txt",
  "src/block_to_tuple.pl",
  "src/tuple_to_block.pl");

file("test/probe_answers.txt",
  "1:",
  "30878,4,2005-12-26",
  "2647871,4,2005-12-30",
  "1283744,3,2004-4-17",
  "2488120,5,2005-9-20",
  "317050,5,2005-11-15",
  "1904905,4,2005-5-13",
  "1989766,4,2005-7-8",
  "14756,4,2005-12-27",
  "1027056,3,2005-12-3",
  "1149588,4,2005-12-13",
  "1394012,5,2005-12-19",
  "1406595,4,2005-8-27",
  "2529547,5,2005-11-18",
  "1682104,4,2005-8-30",
  "2625019,3,2005-9-12",
  "2603381,5,2005-11-29",
  "1774623,4,2005-11-23",
  "470861,5,2004-6-28",
  "712610,4,2005-4-27",
  "1772839,5,2005-9-19",
  "1059319,3,2005-10-10",
  "2380848,5,2005-1-11",
  "548064,5,2005-12-2",
  "10:",
  "1952305,3,2005-7-19",
  "1531863,3,2005-12-21",
  "1000:",
  "2326571,3,2004-11-1",
  "977808,3,2005-4-24",
  "1010534,2,2005-12-5",
  "1861759,5,2005-5-11",
  "79755,5,2005-1-2",
  "98259,5,2004-7-18",
  "1960212,2,2004-10-17",
  "97460,5,2005-6-18",
  "2623506,4,2005-12-27",
  "2409123,4,2005-7-15",
  "1959111,5,2005-11-7",
  "809597,3,2004-8-25",
  "2251189,3,2005-6-26",
  "537705,4,2005-11-19",
  "929584,5,2005-12-12",
  "506737,3,2005-7-11",
  "708895,3,2005-4-1",
  "1900790,4,2005-6-28",
  "2553920,3,2005-8-3",
  "1196779,4,2005-4-1",
  "2411446,1,2005-3-11",
  "1002296,5,2005-6-25",
  "1580442,3,2005-9-12",
  "100291,2,2005-8-9",
  "433455,4,2005-10-12",
  "2368043,5,2005-12-14",
  "906984,4,2005-5-13",
  "10000:",
  "200206,5,2005-6-13",
  "523108,4,2005-6-29",
  "10001:",
  "262828,4,2005-11-1",
  "2609496,4,2005-11-23",
  "1474804,4,2005-11-28",
  "831991,4,2005-12-7",
  "267142,4,2005-12-7",
  "2305771,5,2005-11-19",
  "220050,4,2005-11-26",
  "1959883,5,2005-10-19",
  "27822,5,2005-12-26",
  "2570808,5,2005-12-6",
  "90355,5,2005-12-6",
  "2417258,5,2005-10-23",
  "264764,4,2005-12-26",
  "143866,5,2005-11-15",
  "766895,4,2005-12-19",
  "714089,4,2005-11-29",
  "2350428,5,2005-11-25",
  "10002:",
  "1450941,5,2005-12-27",
  "1213181,4,2005-12-27",
  "308502,5,2005-11-21",
  "2581993,5,2004-12-31",
  "10003:",
  "1515111,3,2005-10-22",
  "10004:",
  "1737087,5,2005-4-3",
  "1270334,5,2005-7-18",
  "1262711,3,2005-10-19",
  "1903515,5,2005-4-12",
  "2140798,5,2005-10-14",
  "2479158,5,2005-5-5",
  "2161335,5,2004-6-29",
  "2099522,5,2005-7-11",
  "1291600,4,2005-5-4",
  "2198877,1,2003-12-15",
  "2214717,5,2005-10-18",
  "1936582,1,2005-12-30",
  "84804,5,2004-10-4",
  "1257912,3,2004-11-15",
  "1263375,5,2005-1-25",
  "735147,4,2004-7-25");

test_inverses_perl($group."_inverse_2",
  "test/probe_answers.txt",
  "src/block_to_tuple.pl",
  "src/tuple_to_block.pl");

# Test the reject feature for removing the probe from the training set.
file("test/probe_test.txt",
  "1:",
  "30878,4,2005-12-26",
  "2647871,4,2005-12-30",
  "10:",
  "1952305,3,2005-7-19",
  "1531863,3,2005-12-21",
  "1000:",
  "2326571,3,2004-11-1",
  "977808,3,2005-4-24");

file("test/probe_test_reject.txt",
  "1:",
  "30878",
  "10:",
  "1952305",
  "1000:",
  "2326571");

test_diff($group."_reject_1",
  "test/probe_test.txt test/probe_test_reject.txt",
  "perl src/block_to_tuple.pl <test/probe_test.txt | "
  ." perl src/tuple_reject.pl "
  ." \"perl src/block_to_tuple.pl <test/probe_test_reject.txt |\" | "
  ." perl src/tuple_to_block.pl",
  "1:",
  "2647871,4,2005-12-30",
  "10:",
  "1531863,3,2005-12-21",
  "1000:",
  "977808,3,2005-4-24");

###############################################################################
$group = "test_invert_ratings";
###############################################################################

file("test/invert_test_1",
  "1:",
  "1,5.1",
  "2,4.1",
  "3:",
  "1,5.3",
  "2,4.3",
  "2:",
  "1,5.2",
  "2,4.2",
  "3,3.2");

test_diff($group."_invert_1",
  "test/invert_test_1",
  "bash src/invert_ratings.sh <test/invert_test_1",
  "1:",
  "1,5.1",
  "2,5.2",
  "3,5.3",
  "2:",
  "1,4.1",
  "2,4.2",
  "3,4.3",
  "3:",
  "2,3.2");

# Note that invert_ratings.rb is not an involution because it sorts movies and
# users. However, it is its own inverse when the input is properly sorted.
file("test/invert_test_1_sorted",
  "1:",
  "1,5.1",
  "2,4.1",
  "2:",
  "1,5.2",
  "2,4.2",
  "3,3.2",
  "3:",
  "1,5.3",
  "2,4.3");

test_inverses_bash($group."_invert_2",
  "test/invert_test_1_sorted",
  "src/invert_ratings.sh",
  "src/invert_ratings.sh");

###############################################################################
$group = "test_symmetric_matrix";
###############################################################################
file("test/matrix_1", # symmetric 3 x 3 - later used for testing term weights
  "7 3 8 ",
  "3 6 1 ",
  "8 1 2 ");
prog("test/matrix_1.bin",
  "test/matrix_1",
  "to_symmetric_binary_matrix",
  "3 <test/matrix_1");

test_inverses_prog($group."_inverse_1",
  "test/matrix_1",
  "to_symmetric_binary_matrix",
  "from_symmetric_binary_matrix", "3");

file("test/matrix_3", # non-symmetric 3 x 3
  "7 4 2 ",
  "3 6 3 ",
  "8 1 2 ");

test_diff($group."_top_1",
  "test/matrix_3 bin",
  "bin/to_symmetric_binary_matrix 3 <test/matrix_3 |"
  ." bin/symmetric_matrix_top 3 3",
  "2 0 8",
  "0 0 7",
  "1 1 6");

file("test/matrix_6", # symmetric 3 x 3
  "1 2 3 ",
  "2 4 5 ",
  "3 5 6 ");
prog("test/matrix_6.bin",
  "test/matrix_6",
  "to_symmetric_binary_matrix",
  "3 <test/matrix_6");

# Try a multiply operation with matrices 1 and 6.
test_diff($group."_symmetrix_matrix_op_1",
  "test/matrix_1.bin test/matrix_6.bin bin",
  "bin/symmetric_matrix_op 3 test/matrix_1.bin mul test/matrix_6.bin |"
  ."bin/from_symmetric_binary_matrix 3",
  "7 6 24 ",
  "6 24 5 ",
  "24 5 12 ");

# Now try a shrink by 1 after the multiply, which is fairly arbitrary.
test_diff($group."_symmetrix_matrix_op_2",
  "test/matrix_1.bin test/matrix_6.bin bin",
  "bin/symmetric_matrix_op 3 test/matrix_1.bin mul test/matrix_6.bin |"
  ."bin/symmetric_matrix_op 3 - shrink 1 |"
  ."bin/from_symmetric_binary_matrix 3",
  "0.875 0.85714287 0.95999998 ",     #   7/8,   6/7, 24/25
  "0.85714287 0.95999998 0.83333331 ",  #   6/7, 24/25,   5/6
  "0.95999998 0.83333331 0.92307693 "); # 24/25,   5/6, 12/13

# Shrink matrix 1 with matrix 6 by 1 (a.*b ./ (b + 1).
test_diff($group."_symmetrix_matrix_op_3",
  "test/matrix_1.bin test/matrix_6.bin bin",
  "bin/symmetric_matrix_op 3 test/matrix_1.bin shrink_with test/matrix_6.bin"
  ." by 1 | bin/from_symmetric_binary_matrix 3",
  "3.5 2 6 ",
  "2 4.8000002 0.83333331 ",
  "6 0.83333331 1.7142857 ");

###############################################################################
$group = "test_term_weights";
###############################################################################
file("test/movie_id_article_num_1", # map of movie ids to article numbers
  "1 0",
  "2 9",
  "3 42");

file("test/ones_3x3.txt", # trivial coratings matrix
  "0 1 1",
  "1 0 1",
  "1 1 0");
prog("test/ones_3x3.bin",
  "test/ones_3x3.txt",
  "to_symmetric_binary_matrix",
  "3 <test/ones_3x3.txt");

file("test/adj_1", # article numbers to terms (an adjacency map)
  "0 2 0 2",
  "9 3 0 1 2",
  "13 2 2 42",
  "42 3 0 9 42");

test_diff($group."_term_movies_1", # output is terms to movie ids
  "test/adj_1 test/movie_id_article_num_1 bin/term_movies",
  "bin/term_movies test/movie_id_article_num_1 <test/adj_1",
  "0 3 3 1 2 3 ",
  "1 1 1 2 ",
  "2 2 2 1 2 ",
  "9 1 1 3 ",
  "42 1 1 3 ");

test_diff($group."_term_weights_1",
  "test/adj_1 test/movie_id_article_num_1 test/matrix_1.bin test/ones_3x3.bin bin",
  "bin/term_movies test/movie_id_article_num_1 <test/adj_1 |"
  ." bin/term_weights 3 test/matrix_1.bin test/ones_3x3.bin",
  "0 4 3",  # 1, 2 & 3 (similarity entries (0,1), (0,2), (1,2) & transposes)
  "2 3 1"); # 1 & 2 (similarity entries (0,1) & transpose)

test_diff($group."_term_weights_3", # test shrinkage (toward zero)
  "test/adj_1 test/movie_id_article_num_1 test/matrix_1.bin test/ones_3x3.bin bin",
  "bin/term_movies test/movie_id_article_num_1 <test/adj_1 |"
  ." bin/term_weights 3 test/matrix_1.bin test/ones_3x3.bin 1",
  "0 3 3",  # \bar{S}=4, B_r(q) = {1,2,3} --> (3*4/(3+1)) = 3
  "2 2 1"); # \bar{S}=3, B_r(q) = {1,2}   --> (2*3/(2+1)) = 2

###############################################################################
$group = "test_term_doc_freq";
###############################################################################

test_diff($group."_term_doc_freq",
  "test/adj_1 bin",
  "bin/term_doc_freq <test/adj_1",
  "0 3", # 0, 9, 42
  "1 1", # 9
  "2 3", # 0, 9, 13
  "9 1", # 42
  "42 2"); # 13, 42

file("test/adj_1_filter",
  "13",
  "42");

test_diff($group."_term_doc_freq_filter",
  "test/adj_1 test/adj_1_filter bin",
  "bin/term_doc_freq test/adj_1_filter <test/adj_1",
  "0 1", # 0, 9, 42
  "2 1", # 0, 9, 13
  "9 1", # 42
  "42 2"); # 13, 42

###############################################################################
$group = "test_smooth_movies";
###############################################################################
file("test/block_ratings_1", # this tests the basics
    "1:",
    "111,1,2007-01-20",
    "112,2.3,1992-07-13",
    "2:",
    "113,3,1965-10-02",
    "3:",
    "112,4,1998-11-03");

file("test/matrix_2", # symmetric 3 x 3
  "   1   0.5  0.25",
  " 0.5     1   0.1",
  "0.25   0.1     1");
prog("test/matrix_2.bin", 
  "test/matrix_2",
  "to_symmetric_binary_matrix",
  "3 <test/matrix_2");

#test_diff($group."_basic",
#  "test/block_ratings_1 test/matrix_2.bin bin",
#  "bin/smooth_movies 3 test/matrix_2.bin 2 <test/block_ratings_1",
#  "1:",      # first movie has enough ratings (unchanged)
#  "111,1",
#  "112,2.3",
#  "2:",      # second movie should pick up both from movie 1
#  "111,0.5",
#  "112,1.15",
#  "113,3",
#  "3:",      # third movie should get one from movie 2
#  "111,0.25",
#  "112,4");

file("test/matrix_4", # symmetric 3 x 3 with no data for movie 2
  "   1     0  0.25",
  "   0     1     0",
  "0.25     0     1");
prog("test/matrix_4.bin", 
  "test/matrix_4",
  "to_symmetric_binary_matrix",
  "3 <test/matrix_4");

#test_diff($group."_missing_data", 
#  "test/block_ratings_1 test/matrix_4.bin bin",
#  "bin/smooth_movies 3 test/matrix_4.bin 3 <test/block_ratings_1",
#  "1:",          # first movie has all its needs
#  "111,1",
#  "112,2.3",    
#  "2:",          # second movie has no data; must keep its one rating
#  "113,3",
#  "3:",          # third movie can pick up one from 1, but not 2.
#  "111,0.25",    # 0.25*1
#  "112,4");

file("test/block_ratings_2", # for averaging test
    "1:",
    "112,1,1992-07-13",
    "2:",
    "112,2,1965-10-02",
    "3:",
    "113,3,1998-11-03");

# Here we try to get 3 ratings per movie, which is not possible.
# These ratings should be taken as residuals (0 centered).
#test_diff($group."_averaging", 
#  "test/block_ratings_2 test/matrix_2.bin bin",
#  "bin/smooth_movies 3 test/matrix_2.bin 3 <test/block_ratings_2",
#  "1:",          # first movie takes from second but can't, so takes from third
#  "112,1",
#  "113,0.75",    # 3 * 0.25
#  "2:",          # second movie much like first movie
#  "112,2",
#  "113,0.3",    # 3 * 0.1
#  "3:",          # third movie should average user 112's two ratings
#  "112,0.225", # (0.25*1 + 0.1*2)/2 = 0.45 / 2 = 0.225
#  "113,3");

###############################################################################
$group = "test_smooth_users";
###############################################################################
file("test/block_ratings_3", # this tests the basics
    "111:",
    "1,1,2007-01-20",
    "2,2.3,1992-07-13",
    "112:",
    "3,3,1965-10-02",
    "113:",
    "2,4,1998-11-03");

#test_diff($group."_basic",
#  "test/block_ratings_3 test/matrix_2.bin bin",
#  "bin/smooth_users 3 test/matrix_2.bin 2 <test/block_ratings_3",
#  "111:",      # first user has enough ratings (unchanged)
#  "1,1",
#  "2,2.3",
#  "112:",      # second user - movie 3 most similar to movie 1
#  "1,0.75",    # 3*0.25
#  "3,3",       # original
#  "113:",      # third user - movie 2 most similar to movie 1
#  "1,2",       # 4*0.5
#  "2,4");

file("test/matrix_5", # here 1 and 2 are both most similar to 3
  "   1  0.25   0.5",
  "0.25     1  0.75",
  " 0.5  0.75     1");
prog("test/matrix_5.bin", 
  "test/matrix_5",
  "to_symmetric_binary_matrix",
  "3 <test/matrix_5");

#test_diff($group."_averaging", 
#  "test/block_ratings_3 test/matrix_5.bin bin",
#  "bin/smooth_users 3 test/matrix_5.bin 3 <test/block_ratings_3",
#  "111:",      # first user needs one more rating - will use 2 and 3.
#  "1,1",       # original
#  "2,2.3",     # original
#  "3,1.1125",  # (1*0.5 + 2.3*0.75)/2 (3 is most similar to 1)
#  "112:",      # second user gets ratings for 2 and 3 
#  "1,1.5",     # 3*0.5
#  "2,2.25",    # 3*0.75
#  "3,3",       # original
#  "113:",      # third user - no data on movie 2
#  "1,1",       # 0.25*4
#  "2,4",       # original
#  "3,3");      # 0.75*4

#test_diff($group."_missing_data", 
#  "test/block_ratings_3 test/matrix_4.bin bin",
#  "bin/smooth_users 3 test/matrix_4.bin 3 <test/block_ratings_3",
#  "111:",      # first user needs one more rating; gets it from 3 since there 
#  "1,1",       # is no data for 2
#  "2,2.3",
#  "3,0.25",    # 1*0.25 (3 is most similar to 1)
#  "112:",      # second user can get a rating for 1 from 3, but not 2
#  "1,0.75",    # 3*0.25
#  "3,3",       # original
#  "113:",      # third user - no data on movie 2
#  "2,4");

###############################################################################
###############################################################################
# Print the phony targets used to organize the test cases.
my @groups = keys(%tests);
for $group (@groups) {
  my $tests = $tests{$group};
  print "$group:$tests\n"
}
print "test: bin/test test_java ".join(" ",@groups)."\n";
print "\tbin/test\n";
print "\t\@echo passed";
print <<EOF;
EOF

# Copyright (c) 2009 John Lees-Miller
# 
# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this software and associated documentation
# files (the "Software"), to deal in the Software without
# restriction, including without limitation the rights to use,
# copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following
# conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.

